home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / COM / World Wide Web Weaver.sit / World Wide Web Weaver / World Wide Web Weaver 1.1.1 д / Extras / MacWebLint 1.011 / MacWebLint.pl-source < prev    next >
Text File  |  1995-12-06  |  28KB  |  1,018 lines
  1. : # use perl                                  -*- mode: Perl; -*-
  2.     eval 'exec perl -S $0 "$@"'
  3.         if $runnning_under_some_shell;
  4.  
  5. # JS 12-6-95
  6. # Moved a bunch of the subs to this file so that this file could be opened
  7. # and modified by MacPerl because it was >32k before.
  8. require "MacWebLint-lib.pl";
  9.  
  10. #
  11. # weblint - pick fluff off WWW pages (html).
  12. #
  13. # Copyright (C) 1994, 1995 Neil Bowers.  All rights reserved.
  14. #
  15. # See README for additional blurb.
  16. # Bugs, comments, suggestions welcome: neilb@khoral.com
  17. #
  18. # Latest version is available as:
  19. #    ftp://ftp.khoral.com/pub/perl/www/weblint.tar.gz
  20. #
  21.  
  22. $VERSION  = '1.011';
  23. ($PROGRAM = $0) =~ s@.*/@@;
  24.  
  25. # JS 12-6-95 Changed line below.
  26. $TMPDIR   = 'tmp';
  27.  
  28. # JS 12-6-95
  29. # Removed usage and todo because it is not really applicable to this port
  30. # of the mac version.
  31. $usage="lots of usage";
  32. $todo="lots to do";
  33.  
  34. *WARNING = *STDOUT;
  35.  
  36. # obsolete tags
  37. $obsoleteTags = 'PLAINTEXT|XMP|LISTING|COMMENT';
  38.  
  39. $maybePaired  = 'LI|DT|DD|P|ROW|TD|TH|TR';
  40.  
  41. $pairElements = 'A|ABBREV|ABOVE|ACRONYM|ADDRESS|ARRAY|AU|'.
  42.                 'HTML|HEAD|BANNER|BAR|BELOW|BIG|BLOCKQUOTE|BODY|BOX|BQ|BT|'.
  43.                 'CAPTION|CREDIT|DDOT|DEL|DIV|DOT|'.
  44.                 'FIG|FN|H1|H2|H3|H4|H5|H6|HAT|INS|LH|OVERLAY|'.
  45.         'B|I|U|TT|STRONG|EM|CODE|KBD|VAR|DFN|CITE|SAMP|Q|LANG|'.
  46.         'UL|OL|DL|'.
  47.                 'MATH|MENU|DIR|FORM|NOTE|PERSON|ROOT|'.
  48.                 'S|SELECT|SMALL|SQRT|STRIKE|STYLE|'.
  49.                 'SUB|SUP|T|TABLE|TEXT|TEXTAREA|TILDE|TITLE|VEC|CODE|PRE|'.
  50.                 $maybePaired.'|'.
  51.                 $obsoleteTags;
  52.  
  53. # expect to see these tags only once
  54. %onceOnly = ('HTML', 1, 'HEAD', 1, 'BODY', 1, 'TITLE', 1);
  55.  
  56. %physicalFontElements =
  57. (
  58.  'B',  'STRONG',
  59.  'I',  'EM',
  60.  'TT', 'CODE, SAMP, KBD, or VAR'
  61.  );
  62.  
  63. # expect these tags to have attributes
  64. # these are elements which have no required attributes, but we expect to
  65. # see at least one of the attributes
  66. $expectArgsRE = 'A';
  67.  
  68. # these tags can only appear in the head element
  69. $headTagsRE = 'TITLE|NEXTID|LINK|BASE|META';
  70.  
  71. %requiredContext =
  72. (
  73.  'ABOVE',     'MATH',
  74.  'ARRAY',     'MATH',
  75.  'ATOP',      'BOX',
  76.  'BAR',       'MATH',
  77.  'BELOW',     'MATH',
  78.  'BOX',       'MATH',
  79.  'BT',        'MATH',
  80.  'CAPTION',   'TABLE|FIG',
  81.  'CHOOSE',    'BOX',
  82.  'DD',        'DL',
  83.  'DDOT',      'MATH',
  84.  'DOT',       'MATH',
  85.  'DT',        'DL',
  86.  'HAT',       'MATH',
  87.  'INPUT',     'FORM',
  88.  'ITEM',      'ROW',
  89.  'LEFT',      'BOX',
  90.  'LH',        'DL|OL|UL',
  91.  'LI',        'DIR|MENU|OL|UL',
  92.  'OF',        'ROOT',
  93.  'OPTION',    'SELECT',
  94.  'OVER',      'BOX',
  95.  'OVERLAY',   'FIG',
  96.  'RIGHT',     'BOX',
  97.  'ROOT',      'MATH',
  98.  'ROW',       'ARRAY',
  99.  'SELECT',    'FORM',
  100.  'SQRT',      'MATH',
  101.  'T',         'MATH',
  102.  'TD',        'TR',
  103.  'TEXT',      'MATH',
  104.  'TEXTAREA',  'FORM',
  105.  'TH',        'TR',
  106.  'TILDE',     'MATH',
  107.  'TR',        'TABLE',
  108.  'VEC',       'MATH'
  109.  );
  110.  
  111. # these tags are allowed to appear in the head element
  112. %okInHead = ('ISINDEX', 1, 'TITLE', 1, 'NEXTID', 1, 'LINK', 1,
  113.          'BASE', 1, 'META', 1, 'RANGE', 1, 'STYLE', 1, '!--', 1);
  114.  
  115. # expect to see these at least once.
  116. # html-outer covers the HTML element
  117. @expectedTags = ('HEAD', 'TITLE', 'BODY');
  118.  
  119. # elements which cannot be nested
  120. $nonNest = 'A|FORM';
  121.  
  122. $netscapeElements = 'NOBR|WBR|FONT|BASEFONT|BLINK|CENTER';
  123.  
  124. #
  125. # This is a regular expression for all legal elements
  126. # UPDATE: need to remove duplication in legalElements and pairElements
  127. #
  128. $legalElements =
  129.    'A|ABBREV|ABOVE|ACRONYM|ADDRESS|ARRAY|ATOP|AU|'.
  130.    'B|BANNER|BAR|BASE|BELOW|BIG|BLOCKQUOTE|BODY|BOX|BQ|BR|BT|'.
  131.    'CAPTION|CHOOSE|CITE|CODE|CREDIT|'.
  132.    'DD|DDOT|DFN|DEL|DIR|DIV|DL|DOT|DT|'.
  133.    'EM|FIG|FN|FORM|H1|H2|H3|H4|H5|H6|HAT|HEAD|HR|HTML|'.
  134.    'I|IMG|INPUT|INS|ISINDEX|ITEM|KBD|'.
  135.    'LANG|LEFT|LH|LI|LINK|MATH|MENU|META|NEXTID|NOTE|'.
  136.    'OF|OL|OPTION|OVER|OVERLAY|P|PERSON|PRE|Q|RANGE|RIGHT|ROOT|ROW|'.
  137.    'SAMP|SELECT|S|SMALL|SQRT|STRIKE|STRONG|STYLE|SUB|SUP|'.
  138.    'T|TAB|TABLE|TD|TEXT|TEXTAREA|TH|TILDE|TITLE|TR|TT|U|UL|VAR|VEC|'.
  139.    $obsoleteTags;
  140.  
  141. # This table holds the valid attributes for elements
  142. # Where an element does not have an entry, this implies that the element
  143. # does not take any attributes
  144. %validAttributes =
  145.    (
  146.    'A',          'ID|LANG|CLASS|HREF|MD|NAME|SHAPE|TITLE|REL|REV',
  147.    'ABOVE',      'SYM',
  148.    'ADDRESS',    'ID|LANG|CLASS|CLEAR|NOWRAP',
  149.    'ARRAY',      'ALIGN|COLDEF|LDELIM|RDELIM|LABELS',
  150.    'BANNER',     'ID|LANG|CLASS',
  151.    'BASE',       'HREF',
  152.    'BR',         'ID|LANG|CLASS|CLEAR',
  153.    'BLOCKQUOTE', 'ID|LANG|CLASS|CLEAR|NOWRAP',
  154.    'BODY',       'ID|LANG|CLASS|BACKGROUND',
  155.    'BOX',        'SIZE',
  156.    'BQ',         'ID|LANG|CLASS|CLEAR|NOWRAP',
  157.    'BELOW',      'SYM',
  158.    'CAPTION',    'ID|LANG|CLASS|ALIGN',
  159.    'CREDIT',     'ID|LANG|CLASS',
  160.    'DD',         'ID|LANG|CLASS|CLEAR',
  161.    'DIV',        'ID|LANG|CLASS|ALIGN|NOWRAP|CLEAR',
  162.    'DL',         'ID|LANG|CLASS|CLEAR|COMPACT',
  163.    'DT',         'ID|LANG|CLASS|CLEAR',
  164.    'FIG',        'ID|LANG|CLASS|CLEAR|NOFLOW|SRC|MD|ALIGN|WIDTH|HEIGHT|'.
  165.                  'UNITS|IMAGEMAP',
  166.    'FN',         'ID|LANG|CLASS',
  167.    'FORM',       'ACTION|METHOD|ENCTYPE|SCRIPT',
  168.    'H1',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  169.    'H2',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  170.    'H3',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  171.    'H4',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  172.    'H5',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  173.    'H6',         'ID|LANG|CLASS|ALIGN|CLEAR|SEQNUM|SKIP|DINGBAT|SRC|MD|NOWRAP',
  174.    'HR',         'ID|CLASS|CLEAR|SRC|MD',
  175.    'HTML',       'VERSION|URN|ROLE',
  176.    'IMG',        'ID|LANG|CLASS|SRC|MD|WIDTH|HEIGHT|UNITS|ALIGN|ALT|ISMAP',
  177.    'INPUT',      'ID|LANG|CLASS|TYPE|NAME|VALUE|DISABLED|ERROR|CHECKED|SIZE|'.
  178.                  'MAXLENGTH|MIN|MAX|ACCEPT|SRC|MD|ALIGN',
  179.    'ITEM',       'ALIGN|COLSPAN|ROWSPAN',
  180.    'LH',         'ID|LANG|CLASS',
  181.    'LI',         'ID|LANG|CLASS|CLEAR|SRC|MD|DINGBAT|SKIP',
  182.    'LINK',       'HREF|REL|REV|URN|TITLE|METHODS',
  183.    'MATH',       'ID|CLASS|BOX',
  184.    'META',       'HTTP-EQUIV|NAME|CONTENT',
  185.    'NEXTID',     'N',
  186.    'NOTE',       'ID|LANG|CLASS|CLEAR|SRC|MD',
  187.    'OL',         'ID|LANG|CLASS|CLEAR|CONTINUE|SEQNUM|COMPACT',
  188.    'OPTION',     'ID|LANG|CLASS|DISABLED|ERROR|VALUE|SELECTED|SHAPE',
  189.    'OVERLAY',    'SRC|MD|UNITS|X|Y|WIDTH|HEIGHT',
  190.    'P',          'ID|LANG|CLASS|ALIGN|CLEAR|NOWRAP',
  191.    'PRE',        'ID|LANG|CLASS|CLEAR|WIDTH',
  192.    'RANGE',      'ID|CLASS|FROM|UNTIL',
  193.    'ROW',        'ALIGN|COLSPAN|ROWSPAN',
  194.    'SELECT',     'ID|LANG|CLASS|NAME|MULTIPLE|DISABLED|ERROR|SRC|MD|WIDTH|'.
  195.                  'HEIGHT|UNITS|ALIGN',
  196.    'STYLE',      'NOTATION',
  197.    'TAB',        'ID|INDENT|TO|ALIGN|DP',
  198.    'TABLE',      'ID|LANG|CLASS|CLEAR|NOFLOW|ALIGN|UNITS|COLSPEC|DP|WIDTH|'.
  199.                  'BORDER|NOWRAP',
  200.    'TD',         'ID|LANG|CLASS|COLSPAN|ROWSPAN|ALIGN|DP|VALIGN|NOWRAP|'.
  201.                  'AXIS|AXES',
  202.    'TEXTAREA',   'ID|LANG|CLASS|NAME|ROWS|COLS|DISABLED|ERROR|ALIGN',
  203.    'TH',         'ID|LANG|CLASS|COLSPAN|ROWSPAN|ALIGN|DP|VALIGN|NOWRAP|'.
  204.                  'AXIS|AXES',
  205.    'TR',         'ID|LANG|CLASS|ALIGN|DP|VALIGN|NOWRAP',
  206.    'UL',         'ID|LANG|CLASS|CLEAR|PLAIN|SRC|MD|DINGBAT|WRAP|COMPACT',
  207.    );
  208.  
  209. %requiredAttributes =
  210.    (
  211.    'BASE',     'HREF',
  212.    'FORM',     'ACTION',
  213.    'IMG',      'SRC',
  214.    'LINK',     'HREF',
  215.    'NEXTID',   'N',
  216.    'SELECT',   'NAME',
  217.    'STYLE',    'NOTATION',
  218.    'TEXTAREA', 'NAME|ROWS|COLS'
  219.    );
  220.  
  221. %validNetscapeAttributes =
  222.    (
  223.    'ISINDEX',  'PROMPT',
  224.    'HR',       'SIZE|WIDTH|ALIGN|NOSHADE',
  225.    'UL',       'TYPE',
  226.    'OL',       'TYPE|START',
  227.    'LI',       'TYPE|VALUE',
  228.    'IMG',      'BORDER|VSPACE|HSPACE',
  229.    'BODY',     'BGCOLOR|TEXT|LINK|VLINK|ALINK',
  230.    'TABLE',    'CELLSPACING|CELLPADDING',
  231.    'TD',       'WIDTH',
  232.    'TH',       'WIDTH'
  233.    );
  234.  
  235. %mustFollow =
  236. (
  237.  'LH',       'UL|OL|DL',
  238.  'OVERLAY',  'FIG',
  239.  'HEAD',     'HTML',
  240.  'BODY',     '/HEAD',
  241.  '/HTML',    '/BODY',
  242.  );
  243.  
  244. ## JS 12-6-95
  245. ## changed to default.html from index.html because mac people
  246. ## usually use default.html :)
  247. %variable =
  248. (
  249.  'directory-index',    'default.html',
  250.  'url-get',        'lynx -source',
  251.  'message-style',    'lint'
  252. );
  253.  
  254. @options = ('d=s', 'e=s', 'stderr', 'help', 'i', 'l', 's', 't', 'todo', 'U',
  255.         'urlget=s', 'v', 'version', 'warnings', 'x=s');
  256.  
  257. $exit_status = 0;
  258.  
  259. require 'newgetopt.pl';
  260. require 'find.pl';
  261.  
  262. # JS 12-6-95
  263. # Line below crashes MacPerl for some reason.
  264. # die "$usage" if @ARGV == 0;
  265.  
  266. &ReadDefaults();
  267. &GetConfigFile();
  268.  
  269. # escape the `-' command-line switch (for stdin), so NGetOpt don't mess wi' it
  270. grep(s/^-$/¥tstdin¥t/, @ARGV);
  271.  
  272. &NGetOpt(@options) || die "use -U switch to display usage statement¥n";
  273.  
  274. # put back the `-' command-line switch, if it was there
  275. grep(s/^¥tstdin¥t$/-/, @ARGV);
  276.  
  277. die "$PROGRAM v$VERSION¥n"            if $opt_v || $opt_version;
  278. die "$usage"                          if $opt_u || $opt_help;
  279. die "$todo"                           if $opt_todo;
  280. &AddExtension($opt_x)                 if $opt_x;
  281. $variable{'message-style'} = 'short'  if $opt_s;
  282. $variable{'message-style'} = 'terse'  if $opt_t;
  283. $variable{'url-get'} = $opt_urlget   if $opt_urlget;
  284. *WARNING = *STDERR                    if $opt_stderr;
  285. &ListWarnings()                      if $opt_warnings;
  286.  
  287. # WARNING file handle is default
  288. select(WARNING);
  289.  
  290. $opt_l = 1                 if $ignore{'SYMLINKS'};
  291.  
  292. # -d to disable warnings
  293. if ($opt_d)
  294. {
  295.    for (split(/,/,$opt_d))
  296.    {
  297.       &enableWarning($_, 0);
  298.    }
  299. }
  300.  
  301. # -e to enable warnings
  302. if ($opt_e)
  303. {
  304.    for (split(/,/,$opt_e))
  305.    {
  306.       &enableWarning($_, 1) || next;
  307.    }
  308. }
  309.  
  310. # -i option to ignore case in element tags
  311. if ($opt_i)
  312. {
  313.    $enabled{'lower-case'} = $enabled{'upper-case'} = 0;
  314. }
  315.  
  316. while (@ARGV > 0)
  317. {
  318.    $arg = shift(@ARGV);
  319.  
  320.    &CheckURL($arg), next if $arg =~ m!^(http|gopher|ftp)://!;
  321.  
  322.    &find($arg), next if -d $arg;
  323.  
  324.    &WebLint($arg), next if (-f $arg && -r $arg) || $arg eq '-';
  325.  
  326.    print "$PROGRAM: could not read $arg: $!¥n";
  327. }
  328.  
  329. exit $exit_status;
  330.  
  331. #========================================================================
  332. # Function:    WebLint
  333. # Purpose:    This is the high-level interface to the checker.  It takes
  334. #        a file and checks for fluff.
  335. #========================================================================
  336. sub WebLint
  337. {
  338.    local($filename,$relpath) = @_;
  339.    local(@tags) = ();
  340.    local($tagRE) = ('');
  341.    local(@taglines) = ();
  342.    local(@orphans) = ();
  343.    local(@orphanlines) = ();
  344.    local(%seenPage);
  345.    local(%seenTag);
  346.    local(%whined);
  347.    local(*PAGE);
  348.    local($line) = ('');
  349.    local($id, $ID);
  350.    local($tag);
  351.    local($closing);
  352.    local($tail);
  353.    local(%args);
  354.    local($arg);
  355.    local($rest);
  356.    local($lastNonTag);
  357.    local(@notSeen);
  358.    local($seenMailtoLink) = (0);
  359.    local($matched);
  360.    local($matchedLine);
  361.    local($novalue);
  362.    local($heading);
  363.    local($headingLine);
  364.    local($commentline);
  365.    local($_);
  366.  
  367.  
  368.    if ($filename eq '-')
  369.    {
  370.       *PAGE = *STDIN;
  371.       $filename = 'stdin';
  372.    }
  373.    else
  374.    {
  375.       return if defined $seenPage{$filename};
  376.       if (-d $filename)
  377.       {
  378.      print "$PROGRAM: $filename is a directory.¥n";
  379.      $exit_status = 0;
  380.      return;
  381.       }
  382.       $seenPage{$filename}++;
  383.       open(PAGE,"<$filename") || do
  384.       {
  385.      print "$PROGRAM: could not read file $filename: $!¥n";
  386.      $exit_status = 0;
  387.      return;
  388.       };
  389.       $filename = $relpath if defined $relpath;
  390.    }
  391.  
  392.    undef $heading;
  393.  
  394.  READLINE:
  395.    while (<PAGE>)
  396.    {
  397.       $line .= $_;
  398.       $line =~ s/¥n/ /g;
  399.  
  400.       while ($line =~ /</o)
  401.       {
  402.      $tail = $'; #'
  403.      undef $lastNonTag;
  404.      $lastNonTag = $` if $` !~ /^¥s*$/o;
  405.  
  406.      #--------------------------------------------------------
  407.      #== SGML comment: <!-- ... blah blah ... -->
  408.      #--------------------------------------------------------
  409.      if ($tail =~ /^!--/o)
  410.      {
  411.  
  412.         $commentline = $. unless defined $commentline;
  413.  
  414.         # push lastNonTag onto word list for spell checking
  415.  
  416.         $ct = $';
  417.         next READLINE unless $ct =~ /--¥s*>/o;
  418.  
  419.         undef $commentline;
  420.  
  421.         $comment = $`;
  422.         $line = $';
  423.  
  424.         # markup embedded in comment can confuse some (most? :-) browsers
  425.         &whine($., 'markup-in-comment') if $comment =~ /<¥s*[^>]+>/o;
  426.         next;
  427.      }
  428.      undef $commentline;
  429.  
  430.      next READLINE unless $tail =~ /^(¥s*)([^>]*)>/;
  431.  
  432.  
  433.      &whine($., 'leading-whitespace', $2) if $1 ne '';
  434.  
  435.          $id = $tag = $2;
  436.          $line = $';
  437.  
  438.          &whine($., 'unknown-element', $id),next if $id =~ /^¥s*$/;
  439.  
  440.      # push lastNonTag onto word list for spell checking
  441.  
  442.          undef $tail;
  443.          undef $closing;
  444.          undef %args;
  445.  
  446.          #-- <!DOCTYPE ... > is ignored for now.
  447.          next if $id =~ /^!doctype/io;
  448.  
  449.      $closing = 0;
  450.          if ($id =~ m@^/@o)
  451.          {
  452.             $id =~ s@^/@@;
  453.         $ID = "¥U$id";
  454.             $closing = 1;
  455.          }
  456.  
  457.          #--------------------------------------------------------
  458.          #== some seriously ugly code to handle attributes ...
  459.          #--------------------------------------------------------
  460.      if ($closing == 0 && $tag =~ m|^(¥S+)¥s+(.*)|)
  461.          {
  462.             ($id,$tail) = ($1,$2);
  463.         $ID = "¥U$id";
  464.         $tail =~ s/¥n/ /g;
  465.  
  466.             # check for odd number of quote characters
  467.             ($quotes = $tail) =~ s/[^"]//g;
  468.             &whine($., 'odd-quotes', $tag) if length($quotes) % 2 == 1;
  469.  
  470.         $novalue = 0;
  471.         $valid = $validAttributes{$ID};
  472.         while ($tail =~ /^¥s*([^=¥s]+)¥s*=¥s*(.*)$/
  473.            # catch attributes like ISMAP for IMG, with no arg
  474.            || ($tail =~ /^¥s*(¥S+)(.*)/ && ($novalue = 1)))
  475.         {
  476.            $arg = "¥U$1";
  477.            $rest = $2;
  478.  
  479.                &whine($., 'unexpected-open', $tag) if $arg =~ /</;
  480.  
  481.            if ($arg !~ /^($valid)$/i && $ID =~ /^($legalElements)$/o)
  482.            {
  483.           if ($arg =~ /^($validNetscapeAttributes{$ID})$/i)
  484.           {
  485.              &whine($., 'netscape-attribute', $arg, $id);
  486.           }
  487.           else
  488.           {
  489.              &whine($., 'unknown-attribute', $id, $arg);
  490.           }
  491.            }
  492.  
  493.                #-- catch repeated attributes.  for example:
  494.                #--     <IMG SRC="foo.gif" SRC="bar.gif">
  495.                if (defined $args{$arg})
  496.                {
  497.                   &whine($., 'repeated-attribute', $arg, $id);
  498.                }
  499.  
  500.            if ($novalue)
  501.            {
  502.           $args{$arg} = '';
  503.           $tail = $rest;
  504.            }
  505.            elsif ($rest =~ /^'([^']+)'(.*)$/)
  506.                {
  507.           &whine($., 'attribute-delimiter', $arg, $ID);
  508.                   $args{$arg} = $1;
  509.                   $tail = $2;
  510.                }
  511.            elsif ($rest =~ /^"([^"]+)"(.*)$/
  512.               || $rest =~ /^'([^']+)'(.*)$/
  513.               || $rest =~ /^(¥S+)(.*)$/)
  514.                {
  515.                   $args{$arg} = $1;
  516.                   $tail = $2;
  517.                }
  518.                else
  519.                {
  520.                   $args{$arg} = $rest;
  521.                   $tail = '';
  522.                }
  523.            $novalue = 0;
  524.             }
  525.         &whine($., 'unexpected-open', $tag) if $tail =~ /</o;
  526.          }
  527.      else
  528.      {
  529.             if ($closing && $id =~ m|^(¥S+)¥s+(.*)|)
  530.             {
  531.            &whine($., 'closing-attribute', $tag);
  532.            $id = $1;
  533.             }
  534.         $ID = "¥U$id";
  535.      }
  536.  
  537.      $TAG = ($closing ? "/" : "").$ID;
  538.      if (defined $mustFollow{$TAG})
  539.      {
  540.         $ok = 0;
  541.         foreach $pre (split(/¥|/, $mustFollow{$TAG}))
  542.         {
  543.            ($ok=1),last if $pre eq $lastTAG;
  544.         }
  545.         if (!$ok || $lastNonTag !~ /^¥s*$/)
  546.         {
  547.            &whine($., 'must-follow', $TAG, $mustFollow{$TAG});
  548.         }
  549.      }
  550.  
  551.      #-- catch empty container elements
  552.      if ($closing && $ID eq $lastTAG && $lastNonTag =~ /^¥s*$/
  553.          && $ID ne 'TEXTAREA')
  554.      {
  555.         &whine($., 'empty-container', $ID);
  556.      }
  557.  
  558.      #-- special case for empty optional container elements
  559.      if (!$closing && $ID eq $tags[$#tags] && $lastTAG eq $ID
  560.          && $ID =~ /^($maybePaired)$/
  561.          && $lastNonTag =~ /^¥s*$/)
  562.      {
  563.         $t = pop @tags;
  564.         $tline = pop @taglines;
  565.         &whine($tline, 'empty-container', $ID);
  566.         $tagRE = join('|',@tags);
  567.      }
  568.  
  569.          #-- whine about unrecognized element, and do no more checks ----
  570.          if ($id !~ /^($legalElements)$/io)
  571.      {
  572.         if ($id =~ /^($netscapeElements)$/io)
  573.         {
  574.            &whine($., 'netscape-markup', ($closing ? "/$id" : "$id"));
  575.         }
  576.         else
  577.         {
  578.            &whine($., 'unknown-element', ($closing ? "/$id" : "$id"));
  579.         }
  580.         next;
  581.      }
  582.  
  583.          if ($closing == 0 && defined $requiredAttributes{$ID})
  584.          {
  585.         @argkeys = keys %args;
  586.         foreach $attr (split(/¥|/,$requiredAttributes{$ID}))
  587.         {
  588.            unless (defined $args{$attr})
  589.            {
  590.           &whine($., 'required-attribute', $attr, $id);
  591.            }
  592.         }
  593.          }
  594.          elsif ($closing == 0 && $id =~ /^($expectArgsRE)$/io)
  595.          {
  596.             &whine($., 'expected-attribute', $id) unless defined %args;
  597.          }
  598.  
  599.          #--------------------------------------------------------
  600.          #== check case of tags
  601.          #--------------------------------------------------------
  602.          &whine($., 'upper-case', $id) if $id ne $ID;
  603.          &whine($., 'lower-case', $id) if $id ne "¥L$id";
  604.  
  605.  
  606.          #--------------------------------------------------------
  607.          #== if tag id is /foo, then strip slash, and mark as a closer
  608.          #--------------------------------------------------------
  609.          if ($closing)
  610.          {
  611.         if ($ID !~ /^($pairElements)$/o)
  612.         {
  613.            &whine($., 'illegal-closing', $id);
  614.         }
  615.  
  616.             if ($ID eq 'A' && $lastNonTag =~ /^¥s*here¥s*$/io)
  617.             {
  618.                &whine($., 'here-anchor');
  619.             }
  620.  
  621.         #-- end of HEAD, did we see a TITLE in the HEAD element? ----
  622.         &whine($., 'require-head') if $ID eq 'HEAD' && !$seenTag{'TITLE'};
  623.  
  624.         #-- was there a <LINK REV=MADE HREF="mailto:.."> element in HEAD?
  625.         &whine($., 'mailto-link') if $ID eq 'HEAD' && $seenMailtoLink == 0;
  626.          }
  627.          else
  628.          {
  629.             #--------------------------------------------------------
  630.             # do context checks.  Should really be a state machine.
  631.             #--------------------------------------------------------
  632.  
  633.         if (defined $physicalFontElements{$ID})
  634.         {
  635.            &whine($., 'physical-font', $ID, $physicalFontElements{$ID});
  636.         }
  637.  
  638.             if ($ID eq 'A' && defined $args{'HREF'})
  639.             {
  640.            $target = $args{'HREF'};
  641.                if ($target =~ /([^:]+):¥/¥/([^¥/]+)(.*)$/
  642.            || $target =~ /^(news|mailto):/
  643.            || $target =~ /^¥//)
  644.                {
  645.                }
  646.                else
  647.                {
  648.           $target =~ s/#.*$//;
  649.           if ($target !~ /^¥s*$/ && ! -f $target && ! -d $target)
  650.           {
  651.              &whine($., 'bad-link', $target);
  652.           }
  653.                }
  654.             }
  655.  
  656.             if ($ID =~ /^H(¥d)$/o)
  657.         {
  658.                if (defined $heading && $1 - $heading > 1)
  659.                {
  660.               &whine($., 'heading-order', $ID, $heading, $headingLine);
  661.                }
  662.                $heading     = $1;
  663.                $headingLine = $.;
  664.         }
  665.  
  666.         #-- check for mailto: LINK ------------------------------
  667.         if ($ID eq 'LINK' && $args{'REV'} =~ /^made$/io
  668.         && $args{'HREF'} =~ /^mailto:/io)
  669.         {
  670.            $seenMailtoLink = 1;
  671.         }
  672.  
  673.         if (defined $onceOnly{$ID})
  674.         {
  675.            &whine($., 'once-only', $ID, $seenTag{$ID}) if $seenTag{$ID};
  676.         }
  677.             $seenTag{$ID} = $.;
  678.  
  679.             &whine($., 'body-no-head') if $ID eq 'BODY' && !$seenTag{'HEAD'};
  680.  
  681.             if ($ID ne 'HTML' && $ID ne '!DOCTYPE' && !$seenTag{'HTML'}
  682.                 && !$whined{'outer-html'})
  683.             {
  684.                &whine($., 'html-outer');
  685.                $whined{'outer-html'} = 1;
  686.             }
  687.  
  688.         #-- check for illegally nested elements ---------------------
  689.         if ($ID =~ /^($nonNest)$/o && $ID =~ /^($tagRE)$/)
  690.         {
  691.            for ($i=$#tags; $tags[$i] ne $ID; --$i)
  692.            {
  693.            }
  694.            &whine($., 'nested-element', $ID, $taglines[$i]);
  695.         }
  696.  
  697.         &whine($., 'unknown-element', $ID) unless $ID =~ /^($legalElements)$/o;
  698.  
  699.         #--------------------------------------------------------
  700.         # check for tags which have a required context
  701.         #--------------------------------------------------------
  702.         if (defined ($reqCon = $requiredContext{$ID}))
  703.         {
  704.            $ok = 0;
  705.            foreach $context (split(/¥|/, $requiredContext{$ID}))
  706.            {
  707.           ($ok=1),last if $context =~ /^($tagRE)$/;
  708.            }
  709.            unless ($ok)
  710.            {
  711.                   &whine($., 'required-context', $ID, $requiredContext{$ID});
  712.            }
  713.         }
  714.  
  715.         #--------------------------------------------------------
  716.         # check for tags which can only appear in the HEAD element
  717.         #--------------------------------------------------------
  718.         if ($ID =~ /^($headTagsRE)$/o && 'HEAD' !~ /^($tagRE)$/)
  719.         {
  720.                &whine($., 'head-element', $ID);
  721.         }
  722.  
  723.         if (! defined $okInHead{$ID} && 'HEAD' =~ /^($tagRE)$/)
  724.         {
  725.                &whine($., 'non-head-element', $ID);
  726.         }
  727.  
  728.         #--------------------------------------------------------
  729.         # check for tags which have been deprecated (now obsolete)
  730.         #--------------------------------------------------------
  731.         &whine($., 'obsolete', $ID) if $ID =~ /^($obsoleteTags)$/o;
  732.          }
  733.  
  734.          #--------------------------------------------------------
  735.          #== was tag of type <TAG> ... </TAG>?
  736.          #== welcome to kludgeville, population seems to be on the increase!
  737.          #--------------------------------------------------------
  738.          if ($ID =~ /^($pairElements)$/o)
  739.          {
  740.         #-- if we have a closing tag, and the tag(s) on top of the stack
  741.         #-- are optional closing tag elements, pop the tag off the stack,
  742.         #-- unless it matches the current closing tag
  743.         if ($closing)
  744.         {
  745.            while (@tags > 0 && $tags[$#tags] ne $ID
  746.               && $tags[$#tags] =~ /^($maybePaired)$/o)
  747.            {
  748.           pop @tags;
  749.           pop @taglines;
  750.            }
  751.            $tagRE = join('|',@tags);
  752.         }
  753.  
  754.             if ($closing && $tags[$#tags] eq $ID)
  755.             {
  756.                $matched     = pop @tags;
  757.                $matchedLine = pop @taglines;
  758.  
  759.            #-- does top of stack match top of orphans stack? --------
  760.            while (@orphans > 0 && @tags > 0
  761.            && $orphans[$#orphans] eq $tags[$#tags])
  762.            {
  763.           &whine($., 'element-overlap', $orphans[$#orphans],
  764.              $orphanlines[$#orphanlines], $matched, $matchedLine);
  765.           pop @orphans;
  766.           pop @orphanlines;
  767.           pop @tags;
  768.           pop @taglines;
  769.            }
  770.                $tagRE = join('|',@tags);
  771.             }
  772.             elsif ($closing && $tags[$#tags] ne $ID)
  773.             {
  774.            #-- closing tag does not match opening tag on top of stack
  775.            if ($ID =~ /^($tagRE)$/)
  776.            {
  777.           # If we saw </HTML>, </HEAD>, or </BODY>, then we try
  778.           # and resolve anything inbetween on the tag stack
  779.           if ($ID =~ /^(HTML|HEAD|BODY)$/o)
  780.           {
  781.              while ($tags[$#tags] ne $ID)
  782.              {
  783.             $ttag = pop @tags;
  784.             $ttagline = pop @taglines;
  785.             if ($ttag !~ /^($maybePaired)$/)
  786.             {
  787.                &whine($., 'unclosed-element', $ttag, $ttagline);
  788.             }
  789.  
  790.             #-- does top of stack match top of orphans stack? --
  791.             while (@orphans > 0 && @tags > 0
  792.                    && $orphans[$#orphans] eq $tags[$#tags])
  793.             {
  794.                pop @orphans;
  795.                pop @orphanlines;
  796.                pop @tags;
  797.                pop @taglines;
  798.             }
  799.              }
  800.  
  801.              #-- pop off the HTML, HEAD, or BODY tag ------------
  802.              pop @tags;
  803.              pop @taglines;
  804.              $tagRE = join('|',@tags);
  805.           }
  806.           else
  807.           {
  808.              #-- matched opening tag lower down on stack
  809.              push(@orphans, $ID);
  810.              push(@orphanlines, $.);
  811.           }
  812.            }
  813.            else
  814.            {
  815.           &whine($., 'mis-match', $ID);
  816.            }
  817.             }
  818.             else
  819.             {
  820.                push(@tags,$ID);
  821.                $tagRE = join('|',@tags);
  822.                push(@taglines,$.);
  823.             }
  824.          }
  825.  
  826.          #--------------------------------------------------------
  827.          #== inline images (IMG) should have an ALT argument :-)
  828.          #--------------------------------------------------------
  829.          &whine($., 'img-alt') if ($ID eq 'IMG'
  830.                    && !defined $args{'ALT'}
  831.                    && !$closing);
  832.  
  833.       } continue {
  834.          $lastTAG = $TAG;
  835.       }
  836.       $lastNonTag = $line;
  837.    }
  838.    close PAGE;
  839.  
  840.    if (defined $commentline)
  841.    {
  842.       &whine($commentline, 'unclosed-comment');
  843.       return;
  844.    }
  845.  
  846.    while (@tags > 0)
  847.    {
  848.       $tag = shift(@tags);
  849.       $line = shift(@taglines);
  850.       if ($tag !~ /^($maybePaired)$/)
  851.       {
  852.      &whine($., 'unclosed-element', $tag, $line);
  853.       }
  854.    }
  855.  
  856.    for (@expectedTags)
  857.    {
  858.       # if we haven't seen TITLE but have seen HEAD
  859.       # then we'll have already whined about the lack of a TITLE element
  860.       next if $_ eq 'TITLE' && !$seenTag{$_} && $seenTag{'HEAD'};
  861.       push(@notSeen,$_) unless $seenTag{$_};
  862.    }
  863.    if (@notSeen > 0)
  864.    {
  865.       printf ("%sexpected tag(s) not seen: @notSeen¥n",
  866.               ($opt_s ? "" : "$filename(-): "));
  867.       $exit_status = 1;
  868.    }
  869. }
  870.  
  871.  
  872. #========================================================================
  873. # Function:    ReadDefaults
  874. # Purpose:    Read the built-in defaults.  These are stored at the end
  875. #               of the script, after the __END__, and read from the
  876. #               DATA filehandle.
  877. #========================================================================
  878. sub ReadDefaults
  879. {
  880.    local(@elements);
  881.  
  882.  
  883.    while (<DATA>)
  884.    {
  885.       chop;
  886.       s/^¥s*//;
  887.       next if /^$/;
  888.  
  889.       push(@elements, $_);
  890.  
  891.       next unless @elements == 3;
  892.  
  893.       ($id, $default, $message) = @elements;
  894.       $enabled{$id} = ($default eq 'ENABLE');
  895.       ($message{$id} = $message) =~ s/"/¥¥"/g;
  896.       undef @elements;
  897.    }
  898. }
  899.  
  900. __END__
  901. upper-case
  902.     DISABLE
  903.     tag <$argv[0]> is not in upper case.
  904. lower-case
  905.     DISABLE
  906.     tag <$argv[0]> is not in lower case.
  907. mixed-case
  908.     ENABLE
  909.     tag case is ignored
  910. here-anchor
  911.     ENABLE
  912.     bad form to use `here' as an anchor!
  913. require-head
  914.     ENABLE
  915.     no <TITLE> in HEAD element.
  916. once-only
  917.     ENABLE
  918.     tag <$argv[0]> should only appear once.  I saw one on line $argv[1]!
  919. body-no-head
  920.     ENABLE
  921.     <BODY> but no <HEAD>.
  922. html-outer
  923.     ENABLE
  924.     outer tags should be <HTML> .. </HTML>.
  925. head-element
  926.     ENABLE
  927.     <$argv[0]> can only appear in the HEAD element.
  928. non-head-element
  929.     ENABLE
  930.     <$argv[0]> cannot appear in the HEAD element.
  931. obsolete
  932.     ENABLE
  933.     <$argv[0]> is obsolete.
  934. mis-match
  935.     ENABLE
  936.     unmatched </$argv[0]> (no matching <$argv[0]> seen).
  937. img-alt
  938.     ENABLE
  939.     IMG does not have ALT text defined.
  940. nested-element
  941.     ENABLE
  942.     <$argv[0]> cannot be nested -- </$argv[0]> not yet seen for <$argv[0]> on line $argv[1].
  943. mailto-link
  944.     DISABLE
  945.     did not see <LINK REV=MADE HREF="mailto..."> in HEAD.
  946. element-overlap
  947.     ENABLE
  948.     </$argv[0]> on line $argv[1] seems to overlap <$argv[2]>, opened on line $argv[3].
  949. unclosed-element
  950.     ENABLE
  951.     no closing </$argv[0]> seen for <$argv[0]> on line $argv[1].
  952. markup-in-comment
  953.     ENABLE
  954.     markup embedded in a comment can confuse some browsers.
  955. unknown-attribute
  956.     ENABLE
  957.     unknown attribute "$argv[1]" for element <$argv[0]>.
  958. leading-whitespace
  959.     ENABLE
  960.     should not have whitespace between "<" and "$argv[0]>".
  961. required-attribute
  962.     ENABLE
  963.     the $argv[0] attribute is required for the <$argv[1]> element.
  964. unknown-element
  965.     ENABLE
  966.     unknown element <$argv[0]>.
  967. odd-quotes
  968.     ENABLE
  969.     odd number of quotes in element <$argv[0]>.
  970. heading-order
  971.     ENABLE
  972.     bad style - heading <$argv[0]> follows <H$argv[1]> on line $argv[2].
  973. bad-link
  974.     DISABLE
  975.     target for anchor "$argv[0]" not found.
  976. expected-attribute
  977.     ENABLE
  978.     expected an attribute for <$argv[0]>.
  979. unexpected-open
  980.     ENABLE
  981.     unexpected < in <$argv[0]> -- potentially unclosed element.
  982. required-context
  983.     ENABLE
  984.     illegal context for <$argv[0]> - must appear in <$argv[1]> element.
  985. unclosed-comment
  986.     ENABLE
  987.     unclosed comment (comment should be: <!-- ... -->).
  988. illegal-closing
  989.     ENABLE
  990.     element <$argv[0]> is not a container -- </$argv[0]> not legal.
  991. netscape-markup
  992.     ENABLE
  993.     <$argv[0]> is netscape specific (use "-x netscape" to allow this).
  994. netscape-attribute
  995.     ENABLE
  996.     attribute `$argv[0]' for <$argv[1]> is netscape specific (use "-x netscape" to allow this).
  997. physical-font
  998.     DISABLE
  999.     <$argv[0]> is physical font markup -- use logical (such as $argv[1]).
  1000. repeated-attribute
  1001.     ENABLE
  1002.     attribute $argv[0] is repeated in element <$argv[1]>
  1003. must-follow
  1004.     ENABLE
  1005.     <$argv[0]> must immediately follow <$argv[1]>
  1006. empty-container
  1007.     ENABLE
  1008.     empty container element <$argv[0]>.
  1009. directory-index
  1010.     ENABLE
  1011.     directory $argv[0] does not have an index file ($argv[1])
  1012. closing-attribute
  1013.     ENABLE
  1014.     closing tag <$argv[0]> should not have any attributes specified.
  1015. attribute-delimiter
  1016.     ENABLE
  1017.     use of ' for attribute value delimiter is not supported by all browsers (attribute $argv[0] of tag $argv[1])
  1018.